home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / uim / lib / srfi-55.scm < prev    next >
Encoding:
Text File  |  2010-11-07  |  3.0 KB  |  70 lines
  1. ;;  Filename : srfi-55.scm
  2. ;;  About    : SRFI-55 require-extension
  3. ;;
  4. ;;  Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
  5. ;;
  6. ;;  All rights reserved.
  7. ;;
  8. ;;  Redistribution and use in source and binary forms, with or without
  9. ;;  modification, are permitted provided that the following conditions
  10. ;;  are met:
  11. ;;
  12. ;;  1. Redistributions of source code must retain the above copyright
  13. ;;     notice, this list of conditions and the following disclaimer.
  14. ;;  2. Redistributions in binary form must reproduce the above copyright
  15. ;;     notice, this list of conditions and the following disclaimer in the
  16. ;;     documentation and/or other materials provided with the distribution.
  17. ;;  3. Neither the name of authors nor the names of its contributors
  18. ;;     may be used to endorse or promote products derived from this software
  19. ;;     without specific prior written permission.
  20. ;;
  21. ;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
  22. ;;  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
  23. ;;  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  24. ;;  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
  25. ;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  26. ;;  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  27. ;;  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  28. ;;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  29. ;;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  30. ;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  31. ;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32.  
  33.  
  34. (define %require-extension-handler-srfi
  35.   (lambda numbers
  36.     (for-each (lambda (n)
  37.                 (let ((srfi-n (string-append "srfi-" (number->string n))))
  38.                   (or (%%require-module srfi-n)
  39.                       (%require-sysfile srfi-n))))
  40.               numbers)))
  41.  
  42. ;; Be quasiquote free to allow --disable-quasiquote
  43. (define %require-extension-alist
  44.   (list
  45.    (cons 'srfi %require-extension-handler-srfi)))
  46.  
  47. (define %require-sysfile
  48.   (lambda (ext-id)
  49.     (or (provided? ext-id)
  50.         (let* ((file (string-append ext-id ".scm"))
  51.                (path (string-append (%%system-load-path) "/" file)))
  52.           (load path)
  53.           (provide ext-id)))))
  54.  
  55. (define %require-extension
  56.   (lambda clauses
  57.     (for-each (lambda (clause)
  58.                 (let* ((id (car clause))
  59.                        (args (cdr clause))
  60.                        (id-str (symbol->string id))
  61.                        (default-handler (lambda ()
  62.                                           (or (%%require-module id-str)
  63.                                               (%require-sysfile id-str))))
  64.                        (handler (cond
  65.                                  ((assq id %require-extension-alist) => cdr)
  66.                                  (else
  67.                                   default-handler))))
  68.                   (apply handler args)))
  69.               clauses)))
  70.